-- Code Emission --

Emit.PeepholeLength 4 #

Emit .inst :-
	Emit.Peephole .inst #

Emit.Peephole .inst :-
	(get PEEPHOLE .list0; .list0 = $),
	list.append .list0 (.inst,) .list1,
	list.length .list1 .len,
	Emit.PeepholeLength .max,
	if (.len <= .max) then (
		.list1 = .list2
	) else (
		.list1 = (.head, .list2),
		Emit.Tuner .head
	),
	Peephole.Optimize (.list2 => .list3),
--	.list2 = .list3,
	set PEEPHOLE .list3 ! #

Emit.Flush :- (
	get PEEPHOLE .list; .list = $
	) !
	Emit.List .list #

Emit.List $ #
Emit.List (.head, .list) :-
	Emit.Tuner .head,
	Peephole.Optimize (.list => .list1),
	Emit.List .list1 #


-- Simple On-the-fly Optimizations --

Emit.Tuner ("MOV" .op (IMM 0)) :-
	Op.Register .op, Emit.Output ("XOR" .op .op) ! #
Emit.Tuner ("ADD" . (IMM 0)) :- ! #
Emit.Tuner ("SUB" . (IMM 0)) :- ! #
Emit.Tuner ("ADD" .op (IMM 1)) :- Emit.Output ("INC" .op) ! #
Emit.Tuner ("SUB" .op (IMM 1)) :- Emit.Output ("DEC" .op) ! #
Emit.Tuner (LABEL .label) :-
	insert (LABEL.DEFINED .label),
	Emit.Output (LABEL .label),
	forall (search (LABEL.SAME .label .label1)) ( -- Generate also binded labels
		Emit.Tuner (LABEL .label1)
	),
	delete.all (LABEL.SAME .label .) ! #
Emit.Tuner .instruction :- Emit.Output .instruction #


-- Peephole Optimizer --

Peephole.Optimize (.list0 => .list1) :- -- Optimize a segment
	list.append .pre .opt0 .list0,
	Peephole.Segment (.opt0 => .opt1),
	list.append .pre .opt1 .list,
	Peephole.Optimize (.list => .list1) ! #
Peephole.Optimize (.list => .list) #

Peephole.Segment ( -- Ignores second of a consecutive jump
	.branch,
	.branch2, .list =>
	.branch, .list) :-
	BranchOut .branch,
	BranchOut .branch2 ! #
Peephole.Segment ( -- Double branching
	LABEL .l1,
	.branch,
	LABEL .l2,
	.branch, .list =>
	LABEL .l1,
	LABEL .l2,
	.branch, .list) :-
	BranchOut .branch ! #
Peephole.Segment ( -- Group up addition/subtraction by constants
	.inst1, .inst2, .list =>
	"ADD" .op (IMM .i3), .list) :-
	IdentifyAddImm .inst1 .op .i1,
	IdentifyAddImm .inst2 .op .i2,
	let .i3 (.i1 + .i2) ! #
Peephole.Segment ( -- Jump to next = no effect
	"JMP" (LABEL .label1),
	LABEL .label2, .list =>
	LABEL .label2, .list) :-
	.label1 = .label2;
	search (LABEL.SAME .label1 .label2);
	search (LABEL.SAME .label2 .label1) ! #
Peephole.Segment ( -- Converts call-n-return to jump
	"CALL" .op,
	"RET", .list =>
	"JMP" .op, .list) :- ! #
Peephole.Segment ( -- Bind up labels
	.branch,
	LABEL .l1,
	"JMP" (LABEL .l2), .list =>
	.branch, .list) :-
	BranchOut .branch,
	not (.l1 = .l2),
	not search (LABEL.DEFINED .l2),
	not search (LABEL.SAME .l1 .l2),
	insert (LABEL.SAME .l2 .l1) ! #

BranchOut "RET" #
BranchOut ("JMP" .) #

IdentifyAddImm (.name .op (IMM .i)) (.op) (.i1) :-
	.name = "ADD", .i1 = .i; .name = "SUB", let .i1 (0 - .i) ! #


-- Output Mechanism --

Emit.Output .instruction :-
	get OUTPUT .out,
	Emit.To .out .instruction,
	stream.nl .out ! #

Emit.To .out .instruction :-
	Dump.Instruction .instruction .string,
	stream.write .out .string #
